﻿{ ******************************************************* }
{ }
{ DelphiWebMVC 5.0 }
{ E-Mail:pearroom@yeah.net }
{ 版权所有 (C) 2022-2 苏兴迎(PRSoft) }
{ }
{ ******************************************************* }
unit MVC.DB;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections, Web.HTTPApp,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error,
  FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async,
  FireDAC.Phys.FBDef, FireDAC.Phys.FB, FireDAC.DApt, Data.DB,
  FireDAC.Comp.Client, MVC.Config, MVC.LogUnit, MVC.DM, MVC.JSON, System.JSON,
  FireDAC.Comp.DataSet, MVC.Tool, MVC.DSQuery, MVC.DataSet;

type
  TDBConns = class
  private
    ConnList: Tlist<TFDConnection>;
  public
    function findDb(DbName: string): TFDConnection; // 找对应名称的数据库链接
    constructor Create();
    destructor Destroy; override;
  end;

  TDBItem = class
  private
    DbConns: TDBConns;
    Conn: TFDConnection;
    FDbState: Integer;
    FID: string;
    TMP_CDS: TDSQuery;
    FOverTime: TDateTime;
    FDriverName: string;
    procedure SetDbState(const Value: Integer);
    procedure SetID(const Value: string);
    procedure SetOverTime(const Value: TDateTime);
    function PageMySql(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageSqlite(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PagePostgreSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL08(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL12(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageFireBird(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageOracle(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    procedure SetDriverName(const Value: string);

  public
    property DbState: Integer read FDbState write SetDbState;
    // 0可用，1使用中，2停用，3可删除
    property ID: string read FID write SetID;
    property OverTime: TDateTime read FOverTime write SetOverTime;
    property DriverName: string read FDriverName write SetDriverName;
    //
    function TryConn: boolean; // 尝试进行数据库链接
    procedure StartTransaction(); // 启动事务
    procedure Commit; // 事务提交
    procedure Rollback; // 事务回滚

    function GetFirstConn: TFDConnection;

    function GetMSSQLVer: string; // 获取mssql 服务器版本 根据版本号使用不同的分页算法
    procedure SetConn(DbName: string); // 设置使用数据库
    function Query(sql: string): IDataSet;

    function ExecSQL(sql: string): Integer; overload;
    function ExecSQL(sqltpl: ISQLTpl): Integer; overload;
    function ExecSQL(cds: TDSQuery): boolean; overload;
    function Find(sql: ISQL): IDataSet; overload;
    function Find(sql: string): IDataSet; overload;
    function Find(sqltpl: ISQLTpl): IDataSet; overload;
    function Find(sqltpl: ISQLTpl; pNumber: Integer; pSize: Integer): IDataSet; overload;
    function Find(sql: ISQL; pNumber: Integer; pSize: Integer): IDataSet; overload; // 分页查询
    function Find(tablename: string; map: IJObject): IDataSet; overload;
    function FindByKey(tablename: string; key: string; Value: string): IDataSet;
    function Add(tablename: string): TDSQuery;
    function Edit(tablename: string; key: string; Value: string): TDSQuery;
    function DelByKey(tablename: string; key: string; Value: string): boolean;
    function filterSQL(sql: string): string;
    function isEmpty(tableName: string; FieldKey, FieldName, FieldDisplay: string; map: IJObject; var res: TResData): boolean;
    //
    constructor Create(isConn: boolean = True);
    destructor Destroy; override;
  end;

  TDBPool = class(TThread)
  private
    isClose: boolean;
    DBList: TDictionary<string, TDBItem>;
    procedure ClearAction;
  protected
    procedure Execute; override;
  public
    procedure setParams;
    function getDbItem: TDBItem;
    procedure freeDbItem(dbitem: TDBItem);
    constructor Create;
    destructor Destroy; override;
  end;

  TDBI = class(TDBItem)
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TDB = class(TDBItem) // 创建时不新建连接
  private
    defdbitem: TDBItem;
    sdb: TDBI;
  public
    function use(DbName: string): TDBI;
    constructor Create;
    destructor Destroy; override;
  end;

  TFieldT = TFieldType;

  TParamT = TParamType;

  IConn = interface
    ['{9837B6A3-176C-4247-8BB7-D566D76A4297}']
    function DB: TDB;
  end;

  TConn = class(TInterfacedObject, IConn)
  private
    FDb: TDB;
  public
    function DB: TDB;
    constructor Create;
    destructor Destroy; override;
  end;

var
  DBPool: TDBPool;

function IIConn: IConn; // 获取一个新的链接

procedure InitDB;//创建链接池

implementation

function IIConn: IConn;
begin
  Result := TConn.Create as IConn;
end;

procedure InitDB;
begin
  if not Assigned(DBPool) then
    DBPool := TDBPool.Create;
end;
{ TDBItem }

function TDBItem.Add(tablename: string): TDSQuery;
var
  sql: string;
begin
  Result := nil;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  try
    sql := filterSQL(sql);
    sql := 'select * from ' + tablename + ' where 1=2';
    TMP_CDS.Connection := Conn;
    TMP_CDS.sql.Text := sql;
    TMP_CDS.Open;
    TMP_CDS.Append;
    Result := TMP_CDS;
  except
    on e: Exception do
    begin
      Result := nil;
      log(e.ToString);
    end;
  end;
end;

procedure TDBItem.Commit;
begin
  DbState := 0;
  if not TryConn then
    Exit;
  Conn.Commit;
end;

constructor TDBItem.Create(isConn: boolean);
begin

  if isConn then
  begin
    DbConns := TDBConns.Create;
  //  if DbConns.ConnList.Count > -1 then
    begin
      Conn := DbConns.ConnList[0];
      DriverName := Conn.DriverName;
    end;
  end;

  DbState := 0;
end;

function TDBItem.DelByKey(tablename, key, Value: string): boolean;
var
  sql: string;
begin
  Result := False;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  if (Trim(key) = '') then
    Exit;
  if (Trim(Value) = '') then
    Exit;
  sql := 'delete from ' + tablename + ' where ' + key + '=' + Value;
  Result := ExecSQL(sql) > -1;
end;

destructor TDBItem.Destroy;
begin
  if Assigned(TMP_CDS) then
  begin
    TMP_CDS.Close;
    TMP_CDS.Free;
    TMP_CDS := nil;
  end;
  if Assigned(DbConns) then
  begin
    DbConns.Free;
  end;

  inherited;
end;

function TDBItem.filterSQL(sql: string): string;
begin
  if Config.show_sql then
    log(sql);
  // Result := sql.Replace(';', '').Replace('-', '');
  Result := sql;
end;

function TDBItem.Edit(tablename, key, Value: string): TDSQuery;
var
  sql: string;
begin
  Result := nil;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  if (Trim(key) = '') then
    Exit;
  try
    sql := 'select * from ' + tablename + ' where ' + key + ' = ' + Value;
    sql := filterSQL(sql);
    TMP_CDS.Connection := Conn;
    TMP_CDS.Open(sql);
    if (not TMP_CDS.IsEmpty) then
    begin
      TMP_CDS.First;
      TMP_CDS.Edit;
      Result := TMP_CDS;
    end
    else
      Result := nil;
  except
    Result := nil;
  end;
end;

function TDBItem.ExecSQL(cds: TDSQuery): boolean;
begin
  Result := False;
  if not TryConn then
    Exit;
  try
    cds.Connection := Conn;
    Result := cds.OpenOrExecute;
  except
    on e: Exception do
    begin
      log('SQL执行异常:' + e.Message);
      Result := False;
    end;
  end;
end;

function TDBItem.ExecSQL(sqltpl: ISQLTpl): Integer;
var
  sql: string;
begin
  sql := sqltpl.AsISQL.sql.Text;
  Result := ExecSQL(sql);
end;

function TDBItem.ExecSQL(sql: string): Integer;
var
  cds: TFDQuery;
begin
  Result := 0;
  if not TryConn then
    Exit;
  if (Trim(sql) = '') then
    Exit;
  cds := TFDQuery.Create(nil);
  try
    try
      sql := filterSQL(sql);
      cds.Connection := Conn;
      Result := cds.ExecSQL(sql);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sql);
        Result := -1;
      end;
    end;
  finally
    cds.Free;
  end;
end;

function TDBItem.Find(sql: ISQL): IDataSet;
var
  s: string;
begin
  Result := nil;
  s := filterSQL(sql.Text);
  Result := Query(s);
end;

function TDBItem.Find(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  device, mssqlver, ver: string;
begin
  device := Conn.DriverName;
  if device.ToLower = 'mysql' then
  begin
    Result := PageMySql(sql, pNumber, pSize);
  end
  else if device.ToLower = 'fb' then
  begin
    Result := PageFireBird(sql, pNumber, pSize);
  end
  else if device.ToLower = 'sqlite' then
  begin
    Result := PageSqlite(sql, pNumber, pSize);
  end
  else if device.ToLower = 'pg' then
  begin
    Result := PagePostgreSQL(sql, pNumber, pSize);
  end
  else if device.ToLower = 'ora' then
  begin
    Result := PageOracle(sql, pNumber, pSize);
  end
  else if device.ToLower = 'mssql' then
  begin
    // 如果是mssql 数据库 判断当前所使用版本来使用
    { SELECT SERVERPROPERTY('ProductVersion') AS 实例版本 }
    mssqlver := GetMSSQLVer;
    ver := mssqlver.Split(['.'])[0];
    if (ver.ToInteger = 10) or (ver.ToInteger = 9) then // 版本是10 是 mssql2008 版本是9 是 mssql2005
    begin
      Result := PageMSSQL08(sql, pNumber, pSize);
    end
    else if ver.ToInteger > 10 then // 大于 10，11：mssql2012;12 mssql2014;13 mssql2016;14mssql2017;
    begin
      Result := PageMSSQL12(sql, pNumber, pSize);
    end
    else if ver.ToInteger = 8 then // 2000版本
    begin
      Result := PageMSSQL(sql, pNumber, pSize);
    end;
  end
  else
    Result := nil;
end;

function TDBItem.Find(sqltpl: ISQLTpl; pNumber, pSize: Integer): IDataSet;
begin
  Result := Find(sqltpl.AsISQL, pNumber, pSize);
end;

function TDBItem.Find(sqltpl: ISQLTpl): IDataSet;
var
  sql: string;
  i_sql: ISQL;
begin
  i_sql := sqltpl.AsISQL;
  if i_sql <> nil then
  begin
    sql := i_sql.sql.Text;
    Result := Query(sql);
  end
  else
  begin
    log('没有获取SQL脚本');
  end;
end;

function TDBItem.Find(sql: string): IDataSet;
begin

  Result := Query(sql);
end;

function TDBItem.Find(tablename: string; map: IJObject): IDataSet;
var
  i: Integer;
  item: TJSONPair;
  key, Value: string;
  sql: ISQL;
  cds: IDataSet;
begin
  cds := Find('select * from ' + tablename + ' where 1<>1 ');
  if cds <> nil then
  begin
    sql := IISQL(tablename);
    for i := 0 to map.O.Count - 1 do
    begin
      item := map.O.Pairs[i];
      key := item.JsonString.Value;
      Value := item.JsonValue.Value;
      if cds.DS.Fields.FindField(key) <> nil then
        sql.AndEqF(key, Value);
    end;
    Result := Find(sql);
  end
  else
  begin
    Result := nil;
  end;
end;

function TDBItem.FindByKey(tablename, key, Value: string): IDataSet;
var
  sql: ISQL;
begin

  try
    if not TryConn then
      Exit;
    if (Trim(tablename) = '') then
      Exit;
    if (Trim(key) = '') then
      Exit;
    if (Trim(Value) = '') then
      Exit;
    sql := IISQL(tablename);
    sql.AndEqF(key, Value);
    Result := Find(sql);
  except
    on e: Exception do
    begin
      log(e.Message);
      Result := nil;
    end;
  end;
end;

function TDBItem.GetFirstConn: TFDConnection;
begin
  if DbConns.ConnList.Count > 0 then
    Result := DbConns.ConnList[0]
  else
    Result := nil;
end;

function TDBItem.GetMSSQLVer: string;
var
  DS: IDataSet;
begin
  DS := Query('SELECT SERVERPROPERTY(''ProductVersion'') AS ver');
  Result := DS.DS.FieldByName('ver').AsString;
end;

function TDBItem.isEmpty(tableName: string; FieldKey, FieldName, FieldDisplay: string; map: IJObject; var res: TResData): boolean;
var
  ds: IDataSet;
  id: string;
  sql: Isql;
  db: IConn;
begin

  db := IIConn;
  sql := IISQL(tableName);
  id := map.S[FieldKey];
  sql.AndEqF(FieldName, map.S[FieldName]);
  if id.Trim <> '' then
    sql.AndNeF(FieldKey, id);

  ds := db.DB.Find(sql);
  if not ds.isEmpty then
  begin
    res.code := -1;
    res.message := FieldDisplay + '已存在';
    Result := false;
  end
  else
  begin
    res.code := 0;
    res.message := '成功';
    Result := true;
  end;
end;

function TDBItem.PageFireBird(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order, sel: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  order := sql.getOrder;
  try
    try
      if sql.getSelect.Trim = '' then
        sel := '*'
      else
        sel := sql.getSelect.Replace('select', '');
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := 'select FIRST ' + inttostr(pSize) + ' SKIP '
        + inttostr(pNumber * pSize) + ' '
        + sel + ' ' + sql.getFrom + ' ' + Trim(order);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  tmp: string;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  order := sql.getOrder;
  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      if Pos('where', sql.getFrom) > 0 then
        tmp := ' and '
      else
        tmp := ' where ';
      sq := ' select top ' + inttostr(pSize) + ' '
        + sql.getSelect.Replace('select', '')
        + sql.getFrom;

      if pNumber > -1 then
      begin
        sq := sq + tmp + ' id not in(select top '
          + inttostr(pSize * pNumber) + ' id '
          + sql.getFrom + ' ' + order + ') ';
      end;
      sq := sq + order;
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PagePostgreSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := sql.getSelect + ' ' + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL08(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  order := sql.getOrder;

  try
    try

      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := ' select *,ROW_NUMBER() OVER(' + order + ') AS RowNo from ('
        + sql.getSelect + ',0 row ' + sql.getFrom + ') tmp1 ';

      sq := ' select * from (' + sq + ') tmp2 where RowNo between '
        + inttostr(pNumber * pSize + 1) + ' and '
        + inttostr(pNumber * pSize + pSize);

      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL12(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  order := sql.getOrder;
  try
    try
      if Trim(order) = '' then
        order := ' order by 1 ';
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + ' ' + sql.getFrom + ' ' + Trim(order)
        + ' offset ' + inttostr(pNumber * pSize)
        + ' rows fetch next ' + inttostr(pSize) + ' rows only ';
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMySql(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageOracle(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := 'select A.*,to_number(rownum) rn from('
        + sql.getSelect + sql.getFrom + ' ' + sql.getOrder + ') A ';
      sq := 'select * from (' + sq + ') where rn > ' + inttostr(pSize * pNumber)
        + ' and rn <=' + inttostr(pSize * pNumber + pSize);

      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageSqlite(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.Query(sql: string): IDataSet;
var
  cds: IDataSet;
  ds: TFDQuery;
begin
  Result := nil;
  if Trim(sql) = '' then
  begin
    DbState := 0;
    Exit;
  end;
  if TryConn then
  begin
    Result := nil;
    ds := TFDQuery.Create(nil);
    try
      try
        sql := filterSQL(sql).Trim;
        ds.Connection := Conn;
        ds.Close;
        ds.SQL.Text:=sql;
        ds.Open;
        cds := IIDataSet;
        cds.DS.AppendData(ds);
        Result := cds;
      except
        on e: Exception do
        begin
          log('SQL执行异常:' + e.Message + '-' + sql);
          Result := nil;
        end;
      end;
    finally
      ds.Free;
    end;
  end
  else
  begin
    log('数据库链接失败：' + self.Conn.ConnectionDefName);
    Result := nil;
    DbState := 0;
  end;
end;

procedure TDBItem.Rollback;
begin
  DbState := 0;
  if not TryConn then
    Exit;
  Conn.Rollback;
end;

procedure TDBItem.SetConn(DbName: string);
begin

  Self.Conn := DbConns.findDb(DbName);
  Self.DriverName := Self.Conn.DriverName;
end;

procedure TDBItem.SetDbState(const Value: Integer);
begin
  FDbState := Value;
end;

procedure TDBItem.SetDriverName(const Value: string);
begin
  FDriverName := Value;
end;

procedure TDBItem.SetID(const Value: string);
begin
  FID := Value;
end;

procedure TDBItem.SetOverTime(const Value: TDateTime);
begin
  FOverTime := Value;
end;

procedure TDBItem.StartTransaction;
begin
  if not TryConn then
    Exit;
  Conn.StartTransaction;
end;

function TDBItem.TryConn: boolean;
begin
  if Conn = nil then
  begin
    Result := False;
    Exit;
  end;
  try
    Conn.CheckActive;
//    if not Conn.Connected then
//      Conn.Connected := True;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
  if Conn.Connected then
  begin
    if TMP_CDS = nil then
    begin
      TMP_CDS := TDSQuery.Create(nil);
      TMP_CDS.Connection := Conn;
    end;
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end;

{ TDB }

constructor TDB.Create;
begin
  inherited Create(False);
  defdbitem := DBPool.getDbItem;
  self.Conn := defdbitem.GetFirstConn;
  DriverName := Conn.DriverName;
end;

destructor TDB.Destroy;
begin
  // 释放链接到连接池
  DBPool.freeDbItem(defdbitem);
  if Assigned(sdb) then
    sdb.free;
//  if Assigned(dbitem) then
//    DBPool.freeDbItem(dbitem);
  inherited;
end;

function TDB.use(DbName: string): TDBI;
begin
  if not Assigned(sdb) then
    sdb := TDBI.Create;
  defdbitem.SetConn(DbName);
  sdb.Conn := defdbitem.Conn;
  Result := sdb;
end;

{ TDBConns }

constructor TDBConns.Create();
var
  dbconfig: IJObject;
  DbType: string;
  i: Integer;
  DB: TFDConnection;
begin
  ConnList := Tlist<TFDConnection>.Create();
  dbconfig := IIJObject(Config.dbconfig);
  for i := 0 to dbconfig.O.Count - 1 do
  begin
    DbType := dbconfig.O.Pairs[i].JsonString.Value;
    DB := TFDConnection.Create(nil);
    DB.ResourceOptions.AutoReconnect := True;
//    DB.FetchOptions.RecordCountMode:=TFDRecordCountMode.cmTotal;
    DB.FetchOptions.RowsetSize := 1000;
    DB.ConnectionDefName := DbType;
    ConnList.Add(DB);
  end;
end;

destructor TDBConns.Destroy;
var
  i: Integer;
begin
  for i := 0 to ConnList.Count - 1 do
  begin
    if ConnList[i].Connected then
      ConnList[i].Connected := False;
    ConnList[i].Free;
  end;
  ConnList.Clear;
  ConnList.Free;
  inherited;
end;

function TDBConns.findDb(DbName: string): TFDConnection;
var
  i: Integer;
begin
  Result := nil;
  Lock(ConnList);
  try
    for i := 0 to ConnList.Count - 1 do
    begin
      if ConnList[i].ConnectionDefName = DbName then
      begin
        Result := ConnList[i];
        break;
      end;
    end;
  finally
    UnLock(ConnList);
  end;

  if Result = nil then
  begin
    log(DbName + '数据库名称未配置');
  end;
end;

{ TDBPool }

constructor TDBPool.Create;
begin
  inherited Create(False);
  DBList := TDictionary<string, TDBItem>.Create();
  isClose := False;
  setParams;
end;

destructor TDBPool.Destroy;
var
  key: string;
  item: TDBItem;
begin

  isClose := True;
  for key in DBList.Keys do
  begin
    if DBList.TryGetValue(key, item) then
      item.Free;
  end;
  DBList.Clear;
  DBList.Free;
  inherited;
end;

procedure TDBPool.ClearAction;
var
  item: TDBItem;
  key: string;
  tmp_dblist: TDictionary<string, TDBItem>;
begin
  if DBList.Count < 2 then
    Exit;
  Lock(DBList);
  tmp_dblist := TDictionary<string, TDBItem>.Create(DBList);
  UnLock(DBList);
  try
    for key in tmp_dblist.Keys do
    begin
      if DBList.TryGetValue(key, item) then
      begin
        if (Now() > item.OverTime) and (item.DbState = 0) then
        begin

          Lock(DBList);
          item.DbState := 2;
          DBList.AddOrSetValue(item.ID, item);
          UnLock(DBList);
          Break;
        end
        else if item.DbState = 2 then
        begin
          Lock(DBList);
          DBList.Remove(item.ID);
          item.Free;
          UnLock(DBList);
          Break;
        end;
      end;
      Sleep(100);
    end;
  finally
    tmp_dblist.Clear;
    tmp_dblist.Free;
  end;
end;

procedure TDBPool.Execute;
var
  k: Integer;
begin
  k := 0;
  while not Terminated do
  begin
    try
      Inc(k);
      if k >= 1000 then
      begin
        k := 0;
        try
          ClearAction;
        except
          on e: Exception do
            log(e.Message);
        end;
      end;
    finally
      Sleep(10);
    end;
  end;
end;

procedure TDBPool.freeDbItem(dbitem: TDBItem);
begin
  Lock(DBList);
  dbitem.DbState := 0;
  DBList.AddOrSetValue(dbitem.ID, dbitem);
  unLock(DBList);
end;

function TDBPool.getDbItem: TDBItem;
var
  key: string;
  item: TDBItem;
  findDb: boolean;

  procedure upitem(item: TDBItem);
  begin

    item.Conn := item.GetFirstConn;
    item.DbState := 1; // 修改为使用中状态
    item.OverTime := Now + (1 / 24 / 60) * 1;
    DBList.AddOrSetValue(item.ID, item);
  end;

begin
  findDb := False;
  Lock(DBList);
  try
    try
      for key in DBList.Keys do
      begin
        if DBList.TryGetValue(key, item) then
        begin
          if item.DbState = 0 then
          begin
            upitem(item);
            findDb := True;
            Break;
          end;
        end;
      end;
      if not findDb then
      begin
        item := TDBItem.Create();
        item.ID := GetGUID;
        upitem(item);
      end;
    except
      Log('获取连接池异常');
    end;
  finally
    UnLock(DBList);
  end;
  Result := item;
end;

procedure TDBPool.setParams;
var
  dbconfig: IJObject;
  connjo: TJSONObject;
  i: Integer;
  key, Value: string;
  oParams: TStringList;
  j: Integer;
  connkey, connValue: string;
  driverID, Database: string;
begin
  with MVCDM do
  begin
    DBManager.Active := False;
    dbconfig := IIJObject(Config.dbconfig);
    for i := 0 to dbconfig.O.Count - 1 do
    begin
      oParams := TStringList.Create;
      key := dbconfig.O.Pairs[i].JsonString.Value;
      connjo := dbconfig.O.Pairs[i].JsonValue as TJSONObject;
      Database := '';
      driverID := '';
      for j := 0 to connjo.Count - 1 do
      begin
        connkey := connjo.Pairs[j].JsonString.Value;
        connValue := connjo.Pairs[j].JsonValue.Value;
        Value := connkey + '=' + Trim(connValue);
        oParams.Add(Value);
        if connkey = 'DriverID' then
          driverID := connValue;
        if connkey = 'Database' then
          Database := connValue;
        if (driverID = 'SQLite') and (Database <> '') then
        begin
          {$IFDEF SERVICE}
          Database := Config.BasePath + oParams.Values['Database'];
          {$ELSE}
          Database := oParams.Values['Database'];
          {$ENDIF}
          Database := IITool.PathFmt(Database);
          LogDebug(Database);
          oParams.Values['Database'] := Database;
          Database := '';
        end;
      end;
      DBManager.AddConnectionDef(key, driverID, oParams);
      oParams.Free;
    end;
    DBManager.Active := True;
  end;
end;

{ TConn }

constructor TConn.Create;
begin
  FDb := TDB.Create;
end;

function TConn.db: TDB;
begin
  Result := FDb;
end;

destructor TConn.Destroy;
begin
  FDb.Free;
  inherited;
end;

{ TDBI }

constructor TDBI.Create;
begin
  inherited Create(False);
end;

destructor TDBI.Destroy;
begin

  inherited;
end;

initialization

finalization
  if Assigned(DBPool) then
    DBPool.Free;

end.

